Example:
#Convert time series to a data frame
ap <- data.frame(passengers=as.matrix(AirPassengers), date=as.numeric(time(AirPassengers)))
# convert date field into separate years and months
ap_ym <- ap %>% mutate(year=year(date_decimal(date)),
month = round((date-floor(date))*12,0)+1) %>%
select(-2)
# subdivide passengers by year
ap_sp <- split(ap_ym$passengers,ap_ym$year)
# summarise passengers by year
ap_sum <- ap_ym %>%
group_by(year) %>%
summarise(min=min(passengers),
ave=round(mean(passengers),0),
max=max(passengers))
#Build data frame skeleton
ap_df <- data.frame(ap_sum,"Box_plot"="","Hist"="","Free_hist"="",
"poly"="", "line_l"="","line_p"="")
# Sparkline output
ap_df %>%
kbl(booktabs = TRUE, caption = "Air Passengers 1949-1960") %>%
kable_styling(position = "left",bootstrap_options = "striped",full_width = FALSE) %>%
column_spec(5, image = spec_boxplot(ap_sp,col="lightblue")) %>%
column_spec(6, image = spec_hist(ap_sp)) %>%
column_spec(7, image = spec_hist(ap_sp,same_lim = FALSE,col="lightblue")) %>%
column_spec(8, image = spec_plot(ap_sp,same_lim = FALSE,col="lightblue",polymin =ap_df$ave)) %>%
column_spec(9, image = spec_plot(ap_sp,same_lim = FALSE,col="lightblue",type="l")) %>%
column_spec(10, image = spec_plot(ap_sp,same_lim = FALSE,col="lightblue",type ="p"))| year | min | ave | max | Box_plot | Hist | Free_hist | poly | line_l | line_p |
|---|---|---|---|---|---|---|---|---|---|
| 1949 | 104 | 127 | 148 | ||||||
| 1950 | 114 | 140 | 170 | ||||||
| 1951 | 145 | 170 | 199 | ||||||
| 1952 | 171 | 197 | 242 | ||||||
| 1953 | 180 | 225 | 272 | ||||||
| 1954 | 188 | 239 | 302 | ||||||
| 1955 | 233 | 284 | 364 | ||||||
| 1956 | 271 | 328 | 413 | ||||||
| 1957 | 301 | 368 | 467 | ||||||
| 1958 | 310 | 381 | 505 | ||||||
| 1959 | 342 | 428 | 559 | ||||||
| 1960 | 390 | 476 | 622 |
Speed <- cars$speed
Distance <- cars$dist
plot(Speed, Distance, panel.first = grid(8, 8),
pch = 0, cex = 1.2, col = "blue")plot(Speed, Distance,
panel.first = lines(stats::lowess(Speed, Distance), lty = "dashed"),
pch = 0, cex = 1.2, col = "blue")## Show the different plot types
x <- 0:12
y <- sin(pi/5 * x)
op <- par(mfrow = c(3,3), mar = .1+ c(2,2,3,1))
for (tp in c("p","l","b", "c","o","h", "s","S","n")) {
plot(y ~ x, type = tp, main = paste0("plot(*, type = \"", tp, "\")"))
if(tp == "S") {
lines(x, y, type = "s", col = "red", lty = 2)
mtext("lines(*, type = \"s\", ...)", col = "red", cex = 0.8)
}
}par(op)##--- Log-Log Plot with custom axes
lx <- seq(1, 5, length.out = 41)
yl <- expression(e^{-frac(1,2) * {log[10](x)}^2})
y <- exp(-.5*lx^2)
op <- par(mfrow = c(2,1), mar = par("mar")-c(1,0,2,0), mgp = c(2, .7, 0))
plot(10^lx, y, log = "xy", type = "l", col = "purple",
main = "Log-Log plot", ylab = yl, xlab = "x")
plot(10^lx, y, log = "xy", type = "o", pch = ".", col = "forestgreen",
main = "Log-Log plot with custom axes", ylab = yl, xlab = "x",
axes = FALSE, frame.plot = TRUE)
my.at <- 10^(1:5)
axis(1, at = my.at, labels = formatC(my.at, format = "fg"))
e.y <- -5:-1 ; at.y <- 10^e.y
axis(2, at = at.y, col.axis = "red", las = 1,
labels = as.expression(lapply(e.y, function(E) bquote(10^.(E)))))par(op)rm(list=ls())
library(tidyverse)
# Create dataset
data <- data.frame(
individual=paste( "Mister ", seq(1,38), sep=""),
group=as.factor(c( rep('OR\n(10)', 10), rep('WAMT\n(15)', 15), rep('CA\n(9)', 9), rep('Alaska\n(4)', 4))) ,
value=sample( seq(10,100), 38, replace=T)
)
# Set a number of 'empty bar' to add at the end of each group
empty_bar <- 3
to_add <- data.frame( matrix(NA, empty_bar*nlevels(data$group), ncol(data)) )
colnames(to_add) <- colnames(data)
to_add$group <- rep(levels(data$group), each=empty_bar)
data <- rbind(data, to_add)
data <- data %>% arrange(group, value)
data$id <- seq(1, nrow(data))
# Get the name and the y position of each label
label_data <- data
number_of_bar <- nrow(label_data)
angle <- 90 - 360 * (label_data$id-0.5) /number_of_bar # I substract 0.5 because the letter must have the angle of the center of the bars. Not extreme right(1) or extreme left (0)
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
# prepare a data frame for base lines
base_data <- data %>%
group_by(group) %>%
summarize(start=min(id), end=max(id) - empty_bar) %>%
rowwise() %>%
mutate(title=mean(c(start, end)))
# prepare a data frame for grid (scales)
grid_data <- base_data
grid_data$end <- grid_data$end[ c( nrow(grid_data), 1:nrow(grid_data)-1)] + 1
grid_data$start <- grid_data$start - 1
grid_data <- grid_data[-1,]
#data = data %>% arrange(group, value)
# Make the plot
p <- ggplot(data, aes(x=as.factor(id), y=value, fill=group)) + # Note that id is a factor. If x is numeric, there is some space between the first bar
geom_bar(aes(x=as.factor(id), y=value, fill=group), stat="identity", alpha=0.5) +
# Add a val=100/75/50/25 lines. I do it at the beginning to make sur barplots are OVER it.
geom_segment(data=grid_data, aes(x = end, y = 80, xend = start, yend = 80), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 60, xend = start, yend = 60), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 40, xend = start, yend = 40), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 20, xend = start, yend = 20), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
# Add text showing the value of each 100/75/50/25 lines
annotate("text", x = rep(max(data$id),4), y = c(20, 40, 60, 80), label = c("20", "40", "60", "80") , color="grey", size=3 , angle=0, fontface="bold", hjust=1) +
geom_bar(aes(x=as.factor(id), y=value, fill=group), stat="identity", alpha=0.5) +
ylim(-100,120) +
theme_minimal() +
theme(
legend.position = "none",
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.margin = unit(rep(-1,4), "cm")
) +
coord_polar() +
geom_text(data=label_data, aes(x=id, y=value+10, label=individual, hjust=hjust), color="black", fontface="bold",alpha=0.6, size=2.5, angle= label_data$angle, inherit.aes = FALSE ) +
# Add base line information
geom_segment(data=base_data, aes(x = start, y = -5, xend = end, yend = -5), colour = "black", alpha=0.8, size=0.6 , inherit.aes = FALSE ) +
geom_text(data=base_data, aes(x = title, y = -18, label=group), hjust=c(1,1,0,0), colour = "black", alpha=0.8, size=3, fontface="bold", inherit.aes = FALSE) +
annotate("text", x = 0, y = -90, label = "System\n(66)")
#p
#p + title(main="AH HA")
p + annotate("text", x = 0, y = -90, label = "Service Area ", hjust=1, vjust=-15)library(tidyverse)
library(ggplot2)
library(ggupset)
library(PSJHR)
df <- data.frame(INSTITUTE = FakeDataPOC$INSTITUTE)
df$yr_mo <- paste0(substr(FakeDataPOC$DischargeDt,6,7),"_",substr(FakeDataPOC$DischargeDt,1,4))
df$mo <- substr(FakeDataPOC$DischargeDt,6,7)
df$yr <- substr(FakeDataPOC$DischargeDt,1,4)
set.seed(1245)
df <- sample_n(df, 5000)
p<-ggplot(df, aes(x=yr_mo)) +
geom_bar() +
axis_combmatrix(sep = "_") +
theme_combmatrix(combmatrix.label.text = element_text(color = "black", size=10),
combmatrix.label.make_space = FALSE,
plot.margin = unit(c(1.5, 1.5, 1.5, 65), "pt"))
p## Put together
main_plot <- df %>% ggplot(aes(x=yr_mo)) +
geom_bar() +
ggtitle("The title", subtitle = "Volume consitency check by year & month") +
axis_combmatrix(sep = "_") +
xlab("Year / Month") +
theme_combmatrix(combmatrix.label.text = element_text(color = "black", size=10),
combmatrix.label.make_space = FALSE,
combmatrix.label.extra_spacing = 0 ,
plot.margin = unit(c(1.5, 1.5, 1.5, 1), "pt"))
side_plot <- df %>%
select(mo) %>%
unnest(cols = mo) %>%
count(mo) %>%
mutate(mo = fct_reorder(as.factor(mo), mo, .desc = TRUE)) %>%
ggplot(aes(y = n, x = mo)) +
geom_col() +
coord_flip() +
scale_y_reverse() +
xlab("") + ylab("") +
theme(axis.ticks.y = element_blank()) # +
# theme(axis.ticks.y = element_blank(), axis.text.y = element_blank())
table(df$yr, df$mo)##
## 01 02 03 04 05 06 07 08 09 10 11 12
## 2017 226 201 210 208 206 202 224 202 202 207 222 213
## 2018 203 182 194 209 225 197 196 226 221 206 199 219
test <- chisq.test(table(df$yr, df$mo))
text1 = paste("X-squared = ",round(test$statistic,3),"\ndf = ",test$parameter, "\np-value = ",round(test$p.value,4))
hold<- ggplot() +
xlim(1,100) + ylim(1,100) +
# annotate("text", x = 95, y = 80, size=3.5, label = "Test:", hjust=1, vjust=1, fontface =2,colour = "darkgrey") +
annotate("text", x = 95, y = 70, size=3.5, label = text1, hjust=1, vjust=1, colour = "darkgrey") +
theme_void()
p<-cowplot::plot_grid(
#cowplot::plot_grid(NULL, side_plot + theme(plot.margin = unit(c(-15, -20, 9, 1), "pt")), ncol = 1, rel_heights = c(1.6, 1)),
cowplot::plot_grid(hold, side_plot + theme(plot.margin = unit(c(-15, -20, 9, 1), "pt")), ncol = 1, rel_heights = c(1.6, 1)),
main_plot, nrow = 1, rel_widths = c(1, 3.5)
)
p#https://www.youtube.com/watch?v=TUKV7Xk1218&list=PL7D2RMSmRO9JOvPC1gbA8Mc3azvSfm8Vv&index=14
library(ggplot2)
library(ggtext)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
ggtitle('Plot 1')
p1 +
labs(title="<strong><span style='color:#ff8c00'>This</span></strong> and <strong><span style='color:red'>That</span></strong>: Some more text"
) +
theme(plot.title = element_markdown(), legend.position= "none")cars %>% DT:: datatable(extensions = 'Buttons',
caption = 'Table 1. the title',
options = list(dom = 'Bt, tp',
buttons = c('copy', 'csv', 'excel'),
lengthMenu = list(c(10,25,50,-1),
c(10,25,50,"All"))))# Charge libraries:
library(ggplot2)
library(gganimate)
#####################
# https://www.datanovia.com/en/blog/gganimate-how-to-create-plots-with-beautiful-animation-in-r/
# https://ugoproto.github.io/ugo_r_doc/pdf/gganimate.pdf
# https://theanlim.rbind.io/post/gganimate-animations-with-ggplot2/
# https://easings.net/en
# https://goodekat.github.io/presentations/2019-isugg-gganimate-spooky/slides.html#56
#########################
df2 <- PSJHR::FakeDataPOC %>%
filter(COHORT=='CABG-EMR') %>%
#mutate(ym = as.Date(paste0(substr(DischargeDt,1,4),'-',substr(DischargeDt,6,7),'-01'), "%y%m")) %>%
mutate(year =substr(DischargeDt,1,4),
month=substr(DischargeDt,6,7)) %>%
mutate(ym =as.Date(paste(year,'01', month, sep = "-"),format = "%Y-%d-%m")) %>%
select(REGION_ABBR, IP.Mortality.Numerator, IP.Mortality.Denominator, IP.LOS.Numerator,ym)%>%
group_by(REGION_ABBR, ym)%>%
summarize(Mortality_rate = sum(IP.Mortality.Numerator, na.rm=TRUE)/sum(IP.Mortality.Denominator, na.rm=TRUE),
n = n(),
IP.LOS.Numerator= mean(IP.LOS.Numerator, na.rm=TRUE))## `summarise()` has grouped output by 'REGION_ABBR'. You can override using the
## `.groups` argument.
a <- df2 %>% as.data.frame() %>%
ggplot( aes(IP.LOS.Numerator, Mortality_rate, size = n, color = REGION_ABBR )) +
geom_point() +
#scale_x_log10() +
theme_bw() +
labs(title = 'Month: {substr(frame_time,1,7)}', x = 'LOS', y = 'Mortality Rate') +
transition_time(ym) +
enter_fade() +
exit_fade() +
shadow_wake(wake_length = 0.1, alpha = FALSE) +
#ease_aes('linear') +
# view_follow(fixed_y = TRUE) + #Let the view follow the data in each frame
ease_aes('cubic-in-out') # Slow start and end for a smoother look
## SAVE ##
# anim_save("271-ggplot2-animated-gif-chart-with-gganimate1.gif")
animate(a,nframes = 100, fps=10, end_pause=30) #, width = 400, height = 600, res = 35)####### As FACETS ##########
df2 %>% as.data.frame() %>%
ggplot( aes(IP.LOS.Numerator, Mortality_rate, size = n, color = REGION_ABBR )) +
geom_point(alpha = 0.7, show.legend = FALSE) +
#scale_x_log10() +
theme_bw() +
labs(title = 'Month: {substr(frame_time,1,7)}', x = 'LOS', y = 'Mortality Rate') +
facet_wrap(~REGION_ABBR) +
transition_time(ym) +
enter_fade() +
exit_fade() +
shadow_wake(wake_length = 0.2, size = 5, alpha = FALSE, colour = 'grey92') +
#ease_aes('linear') +
# view_follow(fixed_y = TRUE) + #Let the view follow the data in each frame
ease_aes('cubic-in-out') # Slow start and end for a smoother look